PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/twins.com/TWINS.DOC

Text File | 1979-11-30 | 29.7 KB | 1,330 lines

                     (***********************************)
                     (*       TWINS Version 1.10        *)
                     (***********************************)
                     (*     Object -Oriented Windows    *)
                     (*  for Turbo Pascal Version 5.5   *)
                     (*         Copyright 1990          *)
                     (*          Brian Corll            *)
                     (*       All Rights Reserved       *)
                     (***********************************)
                     (***********************************)
                     (*   Turbo Pascal is a registered  *)
                     (* trademark of Borland Int. Corp. *)
                     (***********************************)
                     (*   Portions Copyright 1984,1989  *)
                     (*    Borland International Corp.  *)
                     (***********************************)
                     (***********************************)


INTRODUCTION

   Welcome to TWINS  Version 1.10 ! This toolbox  allows you to create
   and  manipulate multiple  windows  on  visible and  virtual screens
   using  the  object-oriented  techniques  available  in Turbo Pascal
   Version 5.5.  Included are assembler routines  to facilitate direct
   writes to video memory and the changing of text attributes. Also, a
   unit has been provided to create simple light-bar menus and a color
   selection menu, and a unit for detection of keyboard activity.

   This toolbox is  COPYRIGHTED SHAREWARE and is NOT  PUBLIC DOMAIN OR
   FREE ! You may use it for a period of up to ninety days to evaluate
   its usefulness  to you. If you  continue to use it  past the ninety
   day  period, please  register your   copy and  help me  continue to
   develop inexpensive toolboxes for Turbo  Pascal. You'll be glad you
   did ! See the file  REGISTER.100 for details. Registered users will
   receive  the complete  source for WINDOWS.TPU,SCREENS.TPU,MENUS.TPU
   AND KEYS.TPU. Sorry, but the assembler source is not for sale.

   Private, non-profit users may register for $ 15.00.
   Commercial and government users may register for $ 25.00.
   Upgrades to the next major  version are available for an additional
   $ 5.00.

   DISCLAIMER

   This  program is  provided "as  is" without  warranty of  any kind,
   either express or implied, including but not limited to the implied
   warranty of merchantability and fitness for a specific purpose. The
   entire risk  as to the quality  and performance of this  program is
   with you.

   In  no event  will the  author be  liable to  you for  any damages,
   including  any lost  profits, lost  savings or  other incidental or
   consequential damages arising out of the use of or inability to use
   this program.

   That  said, please  be assured  that I  have spent  many long hours
   trying to make this toolbox the best  it can be, and I'm working to
   make it even better !

   Now for the inner details:


SCREENS.TPU

UNIT Screens;


{$L Flash}   (* These are the assembler routines that are essential to
{$L Attr}       this toolbox. These routines handle the direct video
{$L Screen}     memory access that this toolbox depends on. *)
{$L Movers}


INTERFACE

Uses DOS;

TYPE

 Borders = String[6];
 (* The window border characters are stored in this string. *)

 VertStr = String[25];
 (* This string is used for vertical string writing. *)

 Direction = (Up,Down);
 (* These direction flags are used for screen scrolling. *)

CONST

 (* These are the predefined border character strings.  Feel free to
    define your own ! *)

 SolidBrdr   : Borders = '██████';
 SingleBrdr  : Borders = '┌└┐┘─│';
 DoubleBrdr  : Borders = '╔╚╗╝═║';
 Stars       : Borders = '******';
 QuarterTone : Borders = '░░░░░░';
 HalfTone    : Borders = '▒▒▒▒▒▒';
 Chr254      : Borders = '■■■■■■';

 (* Color constants - defined to take advantage of Turbo Pascal's
 constant folding capabilities. *)


  Black        = $00;       DarkGray     = $08;
  Blue         = $01;       LightBlue    = $09;
  Green        = $02;       LightGreen   = $0A;
  Cyan         = $03;       LightCyan    = $0B;
  Red          = $04;       LightRed     = $0C;
  Magenta      = $05;       LightMagenta = $0D;
  Brown        = $06;       Yellow       = $0E;
  LightGray    = $07;       White        = $0F;
  Blink        = $80;

  BlackBG      = $00;
  BlueBG       = $10;
  GreenBG      = $20;
  CyanBG       = $30;
  RedBG        = $40;
  MagentaBG    = $50;
  BrownBG      = $60;
  LightGrayBG  = $70;



TYPE

 ScreenType = Array[0..3999] of Byte;
 (* An array buffer used to store an entire screen. *)

 ScrPtr = ^ScreenType;
 (* A pointer to the above array. *)

 DisplayType = (Monochrome, CGA, EGA, MCGA, VGA);
 (* An enumerated type used in determining the video card type *)

VAR
 VideoBase : WORD;
 (* The base address of video memory.  *)

 VideoWait : BOOLEAN;
 (* If TRUE, video writes wait for horizontal retrace. *)

 SnowCheck : BOOLEAN;
 (* If TRUE, CGA video snow checking is turned on. *)

 VideoOffset : BYTE;
 (* The offset of the current character/attribute byte from the video
    memory base address. *)

 VideoMode : BYTE;
 (* The current video mode, 0..3 *)

 VideoWidth : BYTE;
 (* The width of the current video page. *)

 VideoPage  : BYTE;
 (* The current video page number. *)

 Mono : BOOLEAN;
 (* If TRUE, a monochrome monitor is in use. *)

 Regs : Registers;
 (* The CPU's registers. *)

 VidMode : BYTE;
 (* The video  mode is stored here for use  by the assembler
    routines. *)

(***************************************************)
(*             PROCEDURES AND FUNCTIONS            *)
(***************************************************)

PROCEDURE MoveWord (VAR Source,Dest; Count : WORD);
(* Word-size moves *)

Usage:

PROGRAM EXAMPLE;

Uses Screens;

VAR
   T1,T2 : ARRAY[1..100] OF BYTE;

BEGIN
   MoveWord(T1,T2,100);
END.

*******************************************************

FUNCTION  SaveScreen : ScrPtr;
(* Saves the entire screen in VAR of type ScrPtr *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   InitScreen : ScrPtr;

BEGIN
   InitScreen := SaveScreen;
   RestoreScreen(InitScreen);
END.

***************************************************

PROCEDURE RestoreScreen(VAR SavedScreen : ScrPtr);
(* Restores screen previously saved in VAR of type ScrPtr *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   InitScreen : ScrPtr;

BEGIN
   InitScreen := SaveScreen;
   RestoreScreen(InitScreen);
END.

***************************************************

PROCEDURE RestScr(SRow,SCol,ERow,ECol : BYTE;VAR Buffer : POINTER);
(* Restores an area of a screen previously saved in a buffer *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   ScrBuffer : POINTER;

BEGIN
   RestScr(10,20,15,60,ScrBuffer);
END.

***************************************************

PROCEDURE SaveScr(SRow,SCol,ERow,ECol : BYTE;VAR Buffer : POINTER);
(* Saves an area of a screen in a buffer *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   ScrBuffer : POINTER;

BEGIN
   SaveScr(10,20,15,60,ScrBuffer);
END.

***************************************************

PROCEDURE Flash(Row,Col, Attr:byte; Str : String);
(* Writes a string directly to video memory *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   Flash(12,25,White+RedBG,'This is a test string !');
END.

***************************************************

PROCEDURE CursorOn;
(* Need I explain this ?! *)

***************************************************

PROCEDURE CursorOff;
(* Or this ?! *)

***************************************************

PROCEDURE BlockCursor;
(* Turns on a block cursor. *)

***************************************************

PROCEDURE DrawBox(Row1,Col1,Row2,Col2 : Byte;Color : Byte;BorderType : Borders);
(*  Draws  a  colored  box   on  the  screen  using  specified  border
    characters. *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   DrawBox(10,20,15,60,LightCyan+BlackBG,SingleBrdr);
END.

***************************************************

PROCEDURE ChAttr(Number : Word; Row, Col, Attr : Word);
(* Changes a  specified number of video attributes  at a specified row
   and column *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   ChAttr(15,10,20,White+RedBG);
END.

***************************************************

PROCEDURE ChAllAttr(Row,Col,Rows,Cols,Attr : Word);
(* Changes all text attributes in a specified area. *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   ChAllAttr(10,20,5,40,White+RedBG);
END.

***************************************************


PROCEDURE FlashC(Row,Attr:Byte;Str : String);
(* Does a direct video write of a string, centered in a specified
   row. *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   FlashC(1,White+BlueBG,'This string is centered.');
END.

***************************************************

PROCEDURE Vertical(Row,Col,Color : BYTE;Str : VertStr);
(* Writes a string vertically *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   Vertical(1,10,White+MagentaBG,'This string is vertical !');
END.

***************************************************

PROCEDURE Diagonal(Row,Col,Color,Increment : BYTE;Str : String);
(*  Writes  a  string  diagonally,  using  a  specified  increment for
    increasing row and column numbers. *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   Diagonal(1,10,White+MagentaBG,2'This string is vertical !');
END.

***************************************************

PROCEDURE HBar(Row,Col,Len,Color : BYTE;BarChar : CHAR);
(* Creates a horizontal textmode bar *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   HBar(1,10,20,White+MagentaBG,#176);
END.

***************************************************

PROCEDURE VBar(Row,Col,Len,Color : BYTE;BarStr : String);
(* Creates a vertical textmode bar *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   VBar(1,10,20,White+MagentaBG,'XXX');
END.

***************************************************

PROCEDURE Scroll(NumLines,SRow,SCol,ERow,ECol,Color : BYTE;
   WhichWay : Direction);
(* Scrolls a screen region.  NumLines = 0 clears the screen region. *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   Scroll(1,10,20,15,60,Red,Up);
END.

***************************************************

PROCEDURE GetVideoStatus;
(* Gets current video status and returns it in global VARS VideoMode,
   VideoWidth,VideoPage *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   GetVideoStatus;
END.

***************************************************

PROCEDURE SetVideoMode(Mode : BYTE);
(* Select a video mode from 0..3 *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   SetVideoMode(3);
END.

***************************************************

PROCEDURE SetVisiblePage(Page : BYTE);
(* Sets visible video page 0..3 *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   SetVisiblePage(0);
END.

See the file SCRDEMO.PAS for a demonstration of video text paging.

***************************************************

PROCEDURE SetVirtualPage(Page : BYTE);
(*  Set virtual  video page  0..3, allowing  you to  write to "hidden"
    video  pages,  which  may  then  be  made  visible  with a call to
    SetVisiblePage.  *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   SetVirtualPage(1);
   Flash(1,1,White,'This is page two !');
END.

See the file SCRDEMO.PAS for a demonstration of video text paging.

***************************************************

PROCEDURE ClearVirtualPage(Color : BYTE);
(* Clear the  currently selected virtual page using  a specified color
   attribute *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;


BEGIN
   ClearVirtualPage(Black);
END.

***************************************************

FUNCTION  PrintScreen : BOOLEAN;
(* Print a screen and return success/failure *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Success : BOOLEAN;

BEGIN
   Success := PrintScreen;
END.

***************************************************

PROCEDURE ClearScreen(SRow,SCol,ERow,ECol,Color : BYTE);
(* Clear a screen region using a specified color attribute *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

BEGIN
   ClearScreen(10,20,15,60,Red);
END.

***************************************************

FUNCTION GetFG(Color : BYTE) : BYTE;
(* Returns the foreground color value of a color combination *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Color : BYTE;
   FG : BYTE;

BEGIN
   Color := White+RedBG;
   FG := GetFG(Color);
END.

***************************************************

FUNCTION GetBG(Color : BYTE) : BYTE;
(* Returns the background color value of a color combination *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Color : BYTE;
   BG : BYTE;

BEGIN
   Color := White+RedBG;
   BG := GetFG(Color);
END.

***************************************************

PROCEDURE FillScreen(Character : CHAR;Attr : BYTE);
(* Fills the entire screen with a specified character and attribute *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

BEGIN
   FillScreen(#178,White+RedBG);
END.

***************************************************

PROCEDURE FillArea(Row,Col,Rows,Cols,Attr : Byte;Ch : Char);
(*  Fills  a  specified  area  of  the  screen with a specified
    character and attribute. *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

BEGIN
   FillArea(1,1,10,20,White+RedBG,#178);
END.


***************************************************
PROCEDURE CopyScreen(TLRow,TLCol,BRRow,BRCol,NewTLRow,NewTLCol : BYTE);
(* Copies a specified screen area to a new area of the screen. See the
demo file SCRTEST.PAS *)


***************************************************

WINDOWS.TPU

UNIT WINDOWS;

INTERFACE

Uses Screens;

CONST
 Shadow =  TRUE; (* These  BOOLEAN constants are  used to turn  window
                  shadows on or off. *)
 NoShadow = FALSE;


  (* These window borders are defined in SCREENS.PAS:
  SolidBrdr   : Borders = '██████';
  SingleBrdr  : Borders = '┌└┐┘─│';
  DoubleBrdr  : Borders = '╔╚╗╝═║';
  Stars       : Borders = '******';
  QuarterTone : Borders = '░░░░░░';
  HalfTone    : Borders = '▒▒▒▒▒▒'; *)

TYPE

  Positions = (Left,Right,Center);
  (* An enumerated type used in defining window title positions. *)

  Str80 = String[80];

  WindowPtr = ^WindowObject;
  (* Pointer to window object *)

  WindowObject = OBJECT
  WSRow,WERow,WSCol,WECol : BYTE;
  (* Starting and ending rows and columns of window *)

  WinBuf : POINTER;
  (* Pointer to screen save buffer *)

  WFAttr,WBAttr : BYTE;
  (* Foreground and background attributes *)

  WinFill : CHAR;
  (* Window fill character *)

  WinFrame : Borders;
  (* Window frame *)

  WinTitle : Str80;
  (* Window title *)

  WinTitlePos : Positions;
  (* Window title position *)

  ShadowOn : BOOLEAN;
  (* Turns shadows on/off *)

  Active : BOOLEAN;
  (* Stores active/inactive status of window *)

 PROCEDURE SaveWin;
 (* Save a screen region to a buffer *)

 PROCEDURE RestWin;
 (* Restore a screen region from a buffer *)

 PROCEDURE MakeWin(SRow,SCol,ERow,ECol,FAttr,BAttr : BYTE;
   Frame : Borders;FillChar : CHAR;Shadow : BOOLEAN);
   (* Create a window *)

 PROCEDURE RemoveWin;
 (* Remove a window *)

 PROCEDURE FillWin(FillChar : CHAR);
 (* Fill a window with a specified character *)

 PROCEDURE ChFrameAttr(NewAttr : BYTE);
 (* Change window frame attribute *)

 PROCEDURE ChFrame(NewFrame : Borders);
 (* Change frame style *)

 PROCEDURE WriteWin(WRow,WCol : BYTE;WriteStr : String);
 (* Write a string in a window *)

 PROCEDURE WriteWinC(WRow : BYTE;WriteStr : String);
 (* Write a string in a window, centered *)

 PROCEDURE TitleWin(Where : Positions;Title : Str80);
 (* Title a window *)

 PROCEDURE ScrollWin(NumLines : BYTE;WhichWay : Direction);
 (* Scroll window contents NumLines lines up or down *)

 PROCEDURE ClearWin;
 (* Clear window *)

 PROCEDURE MoveWin(NewSRow,NewSCol : BYTE);
 (* Move window to new row and column *)

 CONSTRUCTOR Init;
 (* Initialize an object instance *)

 DESTRUCTOR Done;
 (* Destroy an object instance *)

 END;

VAR
 ShadowColor : BYTE; (* The color used to create shadows *)
 LastWindow : BYTE;  (* the highest window number currently active *)

(*******************************************)
(*                 METHODS                 *)
(*******************************************)

PROCEDURE SaveWin;
(* Save a screen region to a buffer *)

Used internally by TWINS.


***************************************************

PROCEDURE RestWin;
(* Restore a screen region from a buffer *)

Uses internally by TWINS.

***************************************************

PROCEDURE MakeWin(SRow,SCol,ERow,ECol,FAttr,BAttr : BYTE;
   Frame : Borders;FillChar : CHAR;Shadow : BOOLEAN);
(* Create a window *)
   SRow,SCol = Upper left corner row and column
   ERow,ECol = Lower right corner row and column
   FAttr,BAttr = foreground and background attribute bytes
   Frame = frame type (see BORDERS constants in above )
   FillChar = the character used to create the window background
   Shadow = If TRUE, the window has a shadow placed behind it

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   DISPOSE(Test,Done);
END.

***************************************************

PROCEDURE RemoveWin;
(* Remove a window *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

PROCEDURE FillWin(FillChar : CHAR);
(* Fill a window with a specified character *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.FillWin(#176);
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

PROCEDURE ChFrameAttr(NewAttr : BYTE);
(* Change window frame attribute *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.ChFrameAttr(White+BlueBG);
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

PROCEDURE ChFrame(NewFrame : Borders);
(* Change frame style *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.ChFrame(SingleBrdr);
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

PROCEDURE WriteWin(WRow,WCol : BYTE;WriteStr : String);
(* Write a string in a window *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.WriteWin(10,25,'This is a test string');
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

PROCEDURE WriteWinC(WRow : BYTE;WriteStr : String);
(* Write a string in a window, centered *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.WriteWinC(10,'This is a test string');
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

PROCEDURE TitleWin(Where : Positions;Title : Str80);
(* Title a window *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.TitleWin(Center,'WINDOW 1');
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

PROCEDURE ScrollWin(NumLines : BYTE;WhichWay : Direction);
(* Scroll window contents NumLines lines  up or down. If NumLines = 0,
   the window is cleared. *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.ScrollWin(1,Up);
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

PROCEDURE ClearWin;
(* Clear window *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.ClearWin;
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

PROCEDURE MoveWin(NewSRow,NewSCol : BYTE);
(* Move window to new row and column *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.MoveWin(1,1);
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

CONSTRUCTOR Init;
(* Initialize an object instance *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.MoveWin(1,1);
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

DESTRUCTOR Done;
(* Destroy an object instance *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.MoveWin(1,1);
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

PROCEDURE FillArea(Row,Col,Rows,Cols,Attr : Byte;Ch : Char);
(* Fill a screen region with a specified color and attribute *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows;

VAR
   Test : WindowPtr;

BEGIN
   FillArea(1,1,25,80,Cyan+BlueBG,#178);
   NEW(Test,Init);
   Test^.MakeWin(10,20,15,60,White+RedBG,RedBG,DoubleBrdr,#32,TRUE);
   Test^.MoveWin(1,1);
   Test^.RemoveWin;
   DISPOSE(Test,Done);
END.

***************************************************

MENUS.TPU



UNIT Menus;

INTERFACE

Uses Dos,Screens,Windows,Keys;


TYPE
BlinkStatus = (BlinkOn,BlinkOff);
Str2 = String[2];
Str40 = String[40];
Str80 = String[80];


(* The menu definition record *)
MenuRec = RECORD
   Row,Col    : BYTE;
   MenuPrompt : String[40];
   MenuHelp   : String[80];
   MenuLevel  : String[2];
   END;

(* The menu defintion array *)
   MenuDesc = ARRAY[1..25] OF MenuRec;

PROCEDURE MenuDef(VAR TheMenu : MenuDesc;ItemNo : BYTE;Row,Col : BYTE;
   MPrompt : Str40;MHelp : Str80);

FUNCTION  Menu(MenuItems : MenuDesc;LoColor,HiColor,HelpColor : BYTE;
          FirstItem,NumItems : BYTE) : BYTE;

PROCEDURE CreateColorMenu(TLRow,TLCol : BYTE;ShowBlinking : BlinkStatus);

FUNCTION  ColorSelect : BYTE;

PROCEDURE DestroyColorMenu;



IMPLEMENTATION

(***************************************************)
(*             PROCEDURES AND FUNCTIONS            *)
(***************************************************)



PROCEDURE MenuDef(VAR TheMenu : MenuDesc;ItemNo : BYTE;Row,Col : BYTE;
   MPrompt : Str40;MHelp : Str80);
(* Defines an array of menu selection description records *)

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows,Menus;

VAR
   TestMenu : MenuDesc;

BEGIN
   MenuDef(TestMenu,1,1,20,'MENU SELECTION #1','This is menu selection number 1');
END.

*************************

FUNCTION  Menu(MenuItems : MenuDesc;LoColor,HiColor,HelpColor : BYTE;
          FirstItem,NumItems : BYTE) : BYTE;

Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows,Menus;

VAR
   TestMenu : MenuDesc;
   Choice : BYTE;
BEGIN
   MenuDef(TestMenu,1,1,20,'MENU SELECTION #1','This is menu selection number 1');
   MenuDef(TestMenu,2,2,20,'MENU SELECTION #2','This is menu selection number 2');
   MenuDef(TestMenu,3,3,20,'MENU SELECTION #3','This is menu selection number 3');
   MenuDef(TestMenu,4,4,20,'MENU SELECTION #4','This is menu selection number 4');
   MenuDef(TestMenu,5,5,20,'MENU SELECTION #5','This is menu selection number 5');
   Choice := Menu(TestMenu,White+BlueBG,Black+LightGrayBG,Yellow+BlueBG,1,5);
END.

*********************************

The following  two procedures and a  function create a complete
color selection menu, allowing  the user to choose from  a menu of 128
or 256 colors, depending on whether the variable ShowBlinking is set to
BlinkOn or BlinkOff.


PROCEDURE CreateColorMenu(TLRow,TLCol : BYTE;ShowBlinking : BlinkStatus);

FUNCTION  ColorSelect : BYTE;

PROCEDURE DestroyColorMenu;



Usage:

PROGRAM EXAMPLE;

Uses Screens,Windows,Menus;

VAR
   Choice : BYTE;
BEGIN
   CreateColorMenu(2,2,BlinkOn);
   Choice := ColorSelect;
   DestroyColorMenu;
END.

***************************************************


UNIT Keys;

INTERFACE

Uses Dos;

CONST

        (* Constants are defined for the most frequently used keys and
        combinations : *)

        NULL = #3;
        ShiftTab = #15;
        Return = #13;
        Escape = #27;
        Home = #71;
        UpArrow = #72;
        PgUp = #73;
        LeftArrow = #75;
        RightArrow = #77;
        EndKey = #79;
        DownArrow = #80;
        PgDn = #81;
        INS = #82;
        DEL = #83;
        Echo = #114;
        CtrlLeftArrow = #115;
        CtrlRightArrow = #116;
        CtrlEnd = #117;
        CtrlPgDn = #118;
        CtrlHome = #119;
        CtrlPgUp = #132;



        F1 = #59; F2 = #60; F3 = #61; F4 = #62; F5 = #63; F6 = #64;
        F7 = #65; F8 = #66; F9 = #67; F10 = #68;

        ShiftF1 = #84; ShiftF2 = #85; ShiftF3 = #86; ShiftF4 = #87; ShiftF5 = #88;
        ShiftF6 = #89; ShiftF7 = #90; ShiftF8 = #91; ShiftF9 = #92; ShiftF10 = #93;

        CtrlF1 = #94; CtrlF2 = #95; CtrlF3 = #96; CtrlF4 = #97; CtrlF5 = #98;
        CtrlF6 = #99; CtrlF7 = #100; CtrlF8 = #101; CtrlF9 = #102; CtrlF10 = #103;

        AltF1 = #104; AltF2 = #105; AltF3 = #106; AltF4 = #107; AltF5 = #108;
        AltF6 = #109; AltF7 = #110; AltF8 = #111; AltF9 = #112; AltF10 = #113;

        Alt1 = #120; Alt2 = #121; Alt3 = #122; Alt4 = #123; Alt5 = #124;
        Alt6 = #125; Alt7 = #126; Alt8 = #127; Alt9 = #128; Alt0 = #129;
        AltHyphen = #130; AltEqual = #131; AltQ = #16; AltW = #17; AltE = #18;
        AltR = #19; AltT = #20; AltY = #21; AltU = #22; AltI = #23; AltO = #24;
        AltP = #25; AltA = #30; AltS = #31; AltD = #32; AltF = #33; AltG = #34;
        AltH = #35; AltJ = #36; AltK = #37; AltL = #38; AltZ = #44; AltX = #45;
        AltC = #46; AltV = #47; AltB = #48; AltN = #49; AltM = #50;


VAR
        GlobalKey : CHAR;
        (* A 'fake' key used to simulate 'stuffing' the keyboard. *)


FUNCTION  Inkey : CHAR;
(* Returns the value of the last key pressed. This value will be equal
   to one of the constants defined above. *)

PROCEDURE KeyBoard(StuffChar : CHAR);
(*  Sets GlobalKey  equal to  the value  of StuffChar,  which is  then
    returned by the Inkey function *)

IMPLEMENTATION


(***************************************************)
(*               END OF DOCUMENTATION              *)
(***************************************************)



         ----------------end-of-author's-documentation---------------

                        Software Library Information:

                   This disk copy provided as a service of

                        The Public (Software) Library

         We are not the authors of this program, nor are we associated
         with the author in any way other than as a distributor of the
         program in accordance with the author's terms of distribution.

         Please direct shareware payments and specific questions about
         this program to the author of the program, whose name appears
         elsewhere in  this documentation. If you have trouble getting
         in touch with the author,  we will do whatever we can to help
         you with your questions. All programs have been tested and do
         run.  To report problems,  please use the form that is in the
         file PROBLEM.DOC on many of our disks or in other written for-
         mat with screen printouts, if possible.  The P(s)L cannot de-
         bug programs over the telephone.

         Disks in the P(s)L are updated monthly, so if you did not get
         this disk  directly from the P(s)L,  you should be aware that
         the files in this set may no  longer be the current versions.

         For a copy of the latest monthly software library newsletter
         and a list of the 1,000+ disks in the library, call or write

                        The Public (Software) Library
                              P.O.Box 35705
                           Houston, TX 77235-5705
                               [phone]